home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / powertb.arc / WINDOW-2.INC < prev    next >
Encoding:
Text File  |  1986-02-16  |  4.0 KB  |  156 lines
  1. { Turbo Pascal Version 2.0 removable window system
  2.   Copywrite 1984 Michael A. Covington }
  3.  
  4. {===========================================================}
  5. { Modified to speed up screen painting with a color monitor }
  6. {===========================================================}
  7.  
  8. { Requirements: IBM PC or close compatible.
  9.   Screen must be in text mode on page 1,
  10.   either mono or color card.
  11.  
  12.   Call INITWIN berfore calling MKWIN or RMWIN
  13. }
  14.  
  15. const maxwin = 5;  { maximum number of windows open at once }
  16.  
  17. type imagetype  = array [1..4096] of char;
  18.      windimtype = record
  19.                      x1,y1,x2,y2: integer
  20.                   end;
  21.  
  22. var win: { global variable package }
  23.         record
  24.           dim:   windimtype;  { current window dimensions }
  25.           depth: integer;
  26.           stack: array [1..maxwin] of
  27.                    record
  28.                      image: imagetype;  { Saved screen attributes }
  29.                      dim:   windimtype; { Saved window dimensions }
  30.                      x,y:   integer;    { Saved cursor position }
  31.                    end
  32.           end;
  33.  
  34.     crtmode:     byte      absolute $0040:$0049;
  35.     crtwidth:    byte      absolute $0040:$004A;
  36.     monobuffer:  imagetype absolute $B000:$0000;
  37.     colorbuffer: imagetype absolute $B800:$0000;
  38.  
  39. {================}
  40. procedure initwin;
  41. {================}
  42.  
  43. { Records initial window dimensions }
  44.  
  45. begin
  46.    with win.dim do
  47.       begin x1:=1; y1:=1; x2 := crtwidth; y2:=25 end;
  48.    win.depth := 0
  49. end;
  50.  
  51. {=====================================}
  52. procedure boxwin(x1,y1,x2,y2: integer);
  53. {=====================================}
  54.  
  55. { Draws a box, fills it with blanks, and makes it the current
  56.   winddow.  Dimensions given are for the box; actual window
  57.   is one unit smaller in each direction.
  58.   This routine can be used seperately from the rest of the
  59.   removable window package.
  60.  
  61.   Modified 2/27/85 by Tryg Helseth to speed up screen painting using
  62.   on color monitors using ClrScr.
  63. }
  64. var  x,y:  integer;
  65.  
  66. begin
  67.    window(1,1,80,25);
  68.  
  69.    {top}
  70.    gotoxy(x1,y1);
  71.    write(#213);
  72.    for x:=x1+1 to x2-1 do write(#205);
  73.    write(#184);
  74.  
  75.    {sides}
  76.    if crtmode = 7 then
  77.       for y := y1+1 to y2-1 do begin
  78.          gotoxy(x1,y);
  79.          write(#179,' ':x2-x1-1,#179);
  80.          end
  81.    else
  82.       for y := y1+1 to y2-1 do begin
  83.          gotoxy(x1,y); write(#179);
  84.          gotoxy(x2,y); write(#179);
  85.          end;
  86.  
  87.    {bottom}
  88.    gotoxy(x1,y2);
  89.    write(#212);
  90.    for x := x1+1 to x2-1 do write(#205);
  91.    write(#190);
  92.  
  93.    {make it the current window}
  94.    window(x1+1,y1+1,x2-1,y2-1);
  95.  
  96.    { set background }
  97.    if crtmode = 7 then
  98.       gotoxy(1,1)
  99.    else
  100.       ClrScr;
  101. end;
  102.  
  103. {===================================}
  104. procedure mkwin(x1,y1,x2,y2:integer);
  105. {===================================}
  106.  
  107. { Create a removable window }
  108.  
  109. begin
  110.    { increment stack pointer }
  111.    with win do depth := depth + 1;
  112.    if win.depth > maxwin then begin
  113.       writeln(^G,' Windows nested too deep ');
  114.       halt
  115.       end;
  116.  
  117.    { save contents of the screen }
  118.    if crtmode = 7 then
  119.       win.stack[win.depth].image := monobuffer
  120.    else
  121.       win.stack[win.depth].image := colorbuffer;
  122.  
  123.    win.stack[win.depth].dim := win.dim;
  124.    win.stack[win.depth].x   := wherex;
  125.    win.stack[win.depth].y   := wherey;
  126.  
  127.    { create the window }
  128.    boxwin(x1,y1,x2,y2);
  129.    win.dim.x1 := x1+1;
  130.    win.dim.y1 := y1+1;
  131.    win.dim.x2 := x2-1;
  132.    win.dim.y2 := y2-1;
  133. end;
  134.  
  135. {==============}
  136. procedure rmwin;
  137. {==============}
  138.  
  139. { Remove the most recently created removable window
  140.   Restore screen contents, winodw dimensions, and
  141.   position of coursor. }
  142.  
  143. begin
  144.    if crtmode = 7 then
  145.      monobuffer := win.stack[win.depth].image
  146.    else
  147.      colorbuffer := win.stack[win.depth].image;
  148.  
  149.    with win do begin
  150.       dim := stack[depth].dim;
  151.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  152.       gotoxy(stack[depth].x,stack[depth].y);
  153.       depth := depth - 1
  154.       end
  155. end;
  156.